* GenHTML.PRG - HTML Generator. * * Copyright (c) 1998-2003 Microsoft Corp. * 1 Microsoft Way * Redmond, WA 98052 * * Description: * HTML generator using classes in _HTML.VCX. * * Parameter list: * cOutFile: Specifies the name of the output .HTM file. If a file name without * an extention is specified, .HTM is used. * vSource: Specifies the source file name, alias or object. * nShow: 0/.F./Empty = Generate output file only. * 1 = Create output file and view generated file. * 2 = Create output file and show generated file in Internet Explorer. * 3 = Create output file and show based on Save As HTML dialog selection. * 4 = Create PUBLIC _oHTML object and generate file. * 5 = Create PUBLIC _oHTML object without generating file. * vIELink: Specifies a link to Internet Explorer object or Web Browser control. * .F./Empty = No link is created. * .T. = Automatically create instance of Internet Explorer. * Object = Reference to Internet Explorer or Web Browser control. * cStyle: Specifies Style ID reference in GenHTML.dbf. * cScope: Specifies the scope of scan by setting .cScope. * cHTMLClass: Specifies the Class, and optionally, the class library and module, * that is instantiated for HTML object. * Syntax: Class[,ClassLibrary[,Module]] *-- Types #DEFINE VFP_DEFAULT_ID "VFPDefault" *-- Messages #DEFINE M_CLASS_LOC "Class" #DEFINE M_COULD_NOT_BE_INST_LOC "could not be instantiated" #DEFINE M_COULD_NOT_OPENED_EXCL_LOC "could not be opened exclusively to update the table structure." #DEFINE M_FILE_LOC "File" #DEFINE M_FILE_ALREADY_EXISTS_LOC "This file already exists." #DEFINE M_FILE_TYPE_LOC "File type" #DEFINE M_GENHTML_LOC "GenHTML" #DEFINE M_INVALID_SOURCE_REF_LOC "Invalid source reference" #DEFINE M_NOT_FOUND_LOC "not found" #DEFINE M_NOT_SUPPORTED_LOC "not supported" #DEFINE M_OF_LOC "of" #DEFINE M_PROPERTIES_LOC "Properties" #DEFINE M_STYLE_LOC "style" #DEFINE M_REPLACE_EXISTING_FILE_LOC "Replace existing file" #DEFINE M_UNABLE_TO_CREATE_FILE_LOC "Unable to create file" #DEFINE M_UNABLE_TO_FIND_LOC "Unable to find" #DEFINE M_UNABLE_TO_OPEN_FILE_LOC "Unable to open file" *-- ASCII codes #DEFINE TAB CHR(9) #DEFINE LF CHR(10) #DEFINE CR CHR(13) #DEFINE CR_LF CR+LF LPARAMETERS tcOutFile,tvSource,tnShow,tvIELink,tcStyle,tcScope,tcHTMLClass LOCAL lcOutFile,lvSource,oSource,lnShow,lcStyle,lcScope,lcHTMLClass,lcHTMLClassLib LOCAL lcHTMLModule,lcHTMLVCX,lnSourceListCount,lcLastOnError,llSaveAsHTML,lcText LOCAL oRecord,lcGenHTMLTable,lcGenHTMLAlias,lnGenHTMLRecNo,oSaveEnvironment LOCAL lcProgramPath,lcIELinkType,llIELink,oSaveAsHTMLForm,oSaveAsHTML,lnCount LOCAL lcTitle,lcSourceVarType,lcSourceFileExt,ll_oHTMLPublic,llSuccessful,lnAtPos LOCAL laSourceList[1,1],laSelObj[1],laLines[1] EXTERNAL CLASS _html.vcx,_htmlsty.vcx oSaveEnvironment=NEWOBJECT("_SaveEnvironment") lcProgramPath=JUSTPATH(LOWER(SYS(16)))+"\" lcHTMLVCX=IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_HTML.vcx" lcOutFile=IIF(VARTYPE(tcOutFile)=="C",LOWER(ALLTRIM(tcOutFile)),"") IF NOT EMPTY(lcOutFile) AND EMPTY(JUSTEXT(lcOutFile)) lcOutFile=FORCEEXT(lcOutFile,"htm") ENDIF lnShow=IIF(VARTYPE(tnShow)=="N" OR VARTYPE(tnShow)=="I",MIN(MAX(INT(tnShow),0),5),0) lcSourceVarType=VARTYPE(tvSource) DO CASE CASE lcSourceVarType=="C" lvSource=ALLTRIM(tvSource) CASE lcSourceVarType=="O" lvSource=tvSource OTHERWISE lvSource="" lcSourceVarType="C" ENDCASE laSourceList="" lnSourceListCount=0 IF lcSourceVarType=="C" IF EMPTY(lvSource) AND lnShow#5 lvSource=LOWER(GETFILE("dbf;frx;lbx;mnx;scx")) IF EMPTY(lvSource) RETURN .NULL. ENDIF ELSE IF NOT CR$lvSource lvSource=STRTRAN(lvSource,",",CR) ENDIF IF MEMLINES(lvSource)>=2 lnSourceListCount=ALINES(laLines,lvSource) lvSource=laLines[1] lnSourceListCount=lnSourceListCount-1 ADEL(laLines,1) DIMENSION laLines[lnSourceListCount] lnCount=0 DO WHILE .T. lnCount=lnCount+1 IF lnCount>lnSourceListCount EXIT ENDIF IF NOT EMPTY(laLines[lnCount]) LOOP ENDIF ADEL(laLines,lnCount) lnSourceListCount=lnSourceListCount-1 ENDDO IF lnSourceListCount>=1 DIMENSION laSourceList[lnSourceListCount,2] FOR lnCount = 1 TO lnSourceListCount lcText=ALLTRIM(laLines[lnCount]) lnAtPos=AT("@",lcText) IF lnAtPos>0 laSourceList[lnCount,1]=ALLTRIM(SUBSTR(lcText,lnAtPos+1)) laSourceList[lnCount,2]=ALLTRIM(LEFT(lcText,lnAtPos-1)) ELSE laSourceList[lnCount,1]=lcText laSourceList[lnCount,2]="" ENDIF ENDFOR ENDIF ENDIF ENDIF lcSourceFileExt=LOWER(JUSTEXT(lvSource)) IF NOT "!"$lvSource AND NOT EMPTY(lcSourceFileExt) lvSource=LOWER(FULLPATH(lvSource)) ENDIF ENDIF lcIELinkType=VARTYPE(tvIELink) llIELink=INLIST(lcIELinkType,"L","O") lcStyle=IIF(VARTYPE(tcStyle)=="C",LOWER(ALLTRIM(tcStyle)),"") lcScope=IIF(VARTYPE(tcScope)=="C",LOWER(ALLTRIM(tcScope)),"ALL") lcHTMLClass=IIF(VARTYPE(tcHTMLClass)=="C",LOWER(ALLTRIM(tcHTMLClass)),"") llSaveAsHTML=(lnShow=3) lcGenHTMLTable=lcProgramPath+"GenHTML.dbf" lcGenHTMLAlias=LOWER(SYS(2015)) SELECT 0 lcLastOnError=ON("ERROR") ON ERROR =.F. IF FILE(lcGenHTMLTable) USE (lcGenHTMLTable) AGAIN SHARED ALIAS (lcGenHTMLAlias) ENDIF IF EMPTY(lcLastOnError) ON ERROR ELSE ON ERROR &lcLastOnError ENDIF IF NOT _CheckGenHTMLTableStructure(lcGenHTMLTable,lcGenHTMLAlias,lcHTMLVCX) RETURN .NULL. ENDIF SET FILTER TO NOT DELETED() LOCATE oSaveEnvironment.cGenHTMLTable=lcGenHTMLTable oSaveEnvironment.cGenHTMLAlias=lcGenHTMLAlias IF EMPTY(lcStyle) lcStyle=LOWER(VFP_DEFAULT_ID) ENDIF LOCATE FOR LOWER(ALLTRIM(ID))==lcStyle IF EOF() USE _MsgBox(M_UNABLE_TO_FIND_LOC+[ ]+M_STYLE_LOC+[ "]+lcStyle+[".]) RETURN .NULL. ENDIF lnGenHTMLRecNo=RECNO() oSaveEnvironment.nGenHTMLRecNo=lnGenHTMLRecNo SCATTER MEMO NAME oRecord _EvalLinks(Links,oRecord) GO lnGenHTMLRecNo SELECT 0 IF EMPTY(lcHTMLClass) AND NOT EMPTY(oRecord.ClassName) lcHTMLClass=LOWER(ALLTRIM(MLINE(oRecord.ClassName,1))) ENDIF IF EMPTY(lcHTMLClassLib) AND NOT EMPTY(oRecord.ClassLib) lcHTMLClassLib=LOWER(ALLTRIM(MLINE(oRecord.ClassLib,1))) ENDIF IF EMPTY(lcHTMLModule) AND NOT EMPTY(oRecord.Module) lcHTMLModule=LOWER(ALLTRIM(MLINE(oRecord.Module,1))) ENDIF IF lnShow=3 oSaveAsHTMLForm=NEWOBJECT("_HTMLSaveAsDialog",lcHTMLVCX) IF VARTYPE(oSaveAsHTMLForm)#"O" RETURN .NULL. ENDIF oSaveAsHTML=NEWOBJECT("Custom") oSaveAsHTML.AddProperty("cOutFile","") oSaveAsHTML.AddProperty("nShow",0) WITH oSaveAsHTMLForm .oSaveAsHTML=oSaveAsHTML .txtOutFile.Value=lcOutFile .Show lcOutFile=.oSaveAsHTML.cOutFile lnShow=.oSaveAsHTML.nShow IF EMPTY(lcOutFile) RETURN .NULL. ENDIF ENDWITH IF EMPTY(lcOutFile) RETURN .NULL. ENDIF ENDIF IF (llSaveAsHTML OR oSaveEnvironment.cLastSetSafety=="ON") AND ; NOT EMPTY(lcOutFile) AND FILE(lcOutFile) AND ; _MsgBox(lcOutFile+CR_LF+M_FILE_ALREADY_EXISTS_LOC+CR_LF+CR_LF+ ; M_REPLACE_EXISTING_FILE_LOC+"?",292)#6 RETURN .NULL. ENDIF ll_oHTMLPublic=(TYPE("_oHTML")#"U") IF ll_oHTMLPublic AND VARTYPE(_oHTML)=="O" AND PEMSTATUS(_oHTML,"Release",5) _oHTML.Release ENDIF RELEASE _oHTML IF ll_oHTMLPublic OR lnShow=4 OR lnShow=5 ll_oHTMLPublic=.T. PUBLIC _oHTML ELSE PRIVATE _oHTML ENDIF _oHTML=.NULL. lcHTMLModule="" lnAtPos=AT(",",lcHTMLClass) IF lnAtPos>0 lcHTMLClassLib=ALLTRIM(SUBSTR(lcHTMLClass,lnAtPos+1)) lcHTMLClass=ALLTRIM(LEFT(lcHTMLClass,lnAtPos-1)) lnAtPos=AT(",",lcHTMLClassLib) IF lnAtPos>0 lcHTMLModule=ALLTRIM(SUBSTR(lcHTMLClassLib,lnAtPos+1)) lcHTMLClassLib=ALLTRIM(LEFT(lcHTMLClassLib,lnAtPos-1)) ENDIF ELSE IF EMPTY(lcHTMLClassLib) lcHTMLClassLib=LOWER(lcHTMLVCX) ENDIF ENDIF IF LEFT(lcHTMLClass,1)=="(" AND RIGHT(lcHTMLClass,1)==")" lcHTMLClass=EVALUATE(SUBSTR(lcHTMLClass,2,LEN(lcHTMLClass)-2)) ENDIF IF LEFT(lcHTMLClassLib,1)=="(" AND RIGHT(lcHTMLClassLib,1)==")" lcHTMLClassLib=EVALUATE(SUBSTR(lcHTMLClassLib,2,LEN(lcHTMLClassLib)-2)) ENDIF IF LEFT(lcHTMLModule,1)=="(" AND RIGHT(lcHTMLModule,1)==")" lcHTMLModule=EVALUATE(SUBSTR(lcHTMLModule,2,LEN(lcHTMLModule)-2)) ENDIF IF NOT EMPTY(lcHTMLClassLib) AND EMPTY(JUSTEXT(lcHTMLClassLib)) lcHTMLClassLib=FORCEEXT(lcHTMLClassLib,"vcx") ENDIF IF NOT EMPTY(lcHTMLModule) AND EMPTY(JUSTEXT(lcHTMLModule)) lcHTMLModule=FORCEEXT(lcHTMLModule,"app") ENDIF IF NOT EMPTY(lcHTMLClassLib) AND NOT FILE(lcHTMLClassLib) _MsgBox(M_FILE_LOC+[ "]+lcHTMLClassLib+[" ]+M_NOT_FOUND_LOC+[.]) RETURN .NULL. ENDIF IF NOT EMPTY(lcHTMLModule) AND NOT FILE(lcHTMLModule) _MsgBox(M_FILE_LOC+[ "]+lcHTMLModule+[" ]+M_NOT_FOUND_LOC+[.]) RETURN .NULL. ENDIF oSource=.NULL. DO CASE CASE NOT EMPTY(lcHTMLClass) =.F. CASE lcSourceVarType=="O" oSource=lvSource lcHTMLClass="_HTMLObject" CASE lcSourceVarType=="C" AND NOT EMPTY(lvSource) DO CASE CASE EMPTY(lcSourceFileExt) AND NOT EMPTY(lvSource) lcHTMLClass="_HTMLTable" CASE NOT FILE(lvSource) _MsgBox([File "]+lvSource+[" not found.]) RETURN .NULL. CASE lcSourceFileExt=="dbf" lcHTMLClass="_HTMLTable" CASE lcSourceFileExt=="frx" lcHTMLClass="_HTMLReport" CASE lcSourceFileExt=="lbx" lcHTMLClass="_HTMLLabel" CASE lcSourceFileExt=="mnx" lcHTMLClass="_HTMLMenu" CASE lcSourceFileExt=="scx" lcHTMLClass="_HTMLObject" oSaveEnvironment.cWindow=LOWER(SYS(2015)) DEFINE WINDOW (oSaveEnvironment.cWindow) FROM 0,0 TO 0,0 NONE MODIFY FORM (lvSource) IN WINDOW (oSaveEnvironment.cWindow) NOWAIT IF ASELOBJ(laSelObj,1)#1 RELEASE WINDOW (oSaveEnvironment.cWindow) _MsgBox(M_UNABLE_TO_OPEN_FILE_LOC+[ "]+lvSource+[".]) RETURN .NULL. ENDIF oSource=laSelObj[1] IF WVISIBLE(M_PROPERTIES_LOC) oSaveEnvironment.lWindow=.T. HIDE WINDOW (M_PROPERTIES_LOC) ENDIF OTHERWISE IF EMPTY(lvSource) _MsgBox(M_INVALID_SOURCE_REF_LOC+".") ELSE _MsgBox(M_FILE_TYPE_LOC+" "+lvSource+" "+M_NOT_SUPPORTED_LOC+".") ENDIF RETURN .NULL. ENDCASE OTHERWISE lcHTMLClass="_HTMLDocument" ENDCASE lcLastOnError=ON("ERROR") ON ERROR =.F. _oHTML=NEWOBJECT(lcHTMLClass,lcHTMLClassLib) IF EMPTY(lcLastOnError) ON ERROR ELSE ON ERROR &lcLastOnError ENDIF IF VARTYPE(_oHTML)#"O" _oHTML=.NULL. _MsgBox(M_CLASS_LOC+[ (]+lcHTMLClass+[) ]+M_OF_LOC+[ "]+LOWER(lcHTMLClassLib)+ ; [" ]+M_COULD_NOT_BE_INST_LOC+[.]) RETURN .NULL. ENDIF IF lnShow#5 AND EMPTY(lcOutFile) lcOutFile=_oHTML.GetFile() IF EMPTY(lcOutFile) IF VARTYPE(_oHTML)=="O" _oHTML.Release ENDIF _oHTML=.NULL. RETURN .NULL. ENDIF ENDIF IF llIELink DO CASE CASE lcIELinkType=="L" AND tvIELink _oHTML.CreateIELink CASE lcIELinkType=="O" _oHTML.IE=tvIELink ENDCASE ENDIF _oHTML.oRecord=oRecord _oHTML.cGenHTMLTable=lcGenHTMLTable _oHTML.cGenHTMLAlias=lcGenHTMLAlias _oHTML.lMessageBar=.T. _oHTML.cOutFile=lcOutFile _oHTML.oSource=oSource _oHTML.cSourceFile=IIF(VARTYPE(lvSource)=="C",lvSource,"") _oHTML.nSourceListCount=lnSourceListCount ACOPY(laSourceList,_oHTML.aSourceList) _oHTML.cScope=lcScope _oHTML.oProperties=_oHTML.NewTag() _oHTML.oProperties.SetProperties(oRecord.Properties) _oHTML.RunCode(_oHTML.oRecord.PreScript) IF PEMSTATUS(_oHTML,"Head",5) _oHTML.Head.AddItem(_oHTML.oRecord.HeadStart) IF EMPTY(_oHTML.cSourceFile) IF VARTYPE(lvSource)=="O" AND PEMSTATUS(lvSource,"Name",5) lcTitle=ALLTRIM(TRANSFORM(lvSource.Name)) ELSE lcTitle="" ENDIF ELSE lcTitle=_oHTML.cSourceFile ENDIF _oHTML.Head.Title.Item=lcTitle ENDIF IF PEMSTATUS(_oHTML,"Body",5) _oHTML.Body.AddItem(_oHTML.oRecord.BodyStart) ENDIF _oHTML.nWorkArea=oSaveEnvironment.nLastSelect IF lnShow=5 llSuccessful=.T. ELSE llSuccessful=_oHTML.Generate() ENDIF SELECT 0 IF NOT llSuccessful IF VARTYPE(_oHTML)=="O" _oHTML.Release ENDIF _oHTML=.NULL. RETURN .NULL. ENDIF _oHTML.RunCode(_oHTML.oRecord.PostScript) IF PEMSTATUS(_oHTML,"Head",5) IF NOT EMPTY(_oHTML.oRecord.Style) _oHTML.Head.CSS=_oHTML.Head.AddTag("style") _oHTML.Head.CSS.AddItem(_oHTML.oRecord.Style) ENDIF _oHTML.Head.AddItem(_oHTML.oRecord.HeadEnd) ENDIF IF PEMSTATUS(_oHTML,"Body",5) AND NOT ISNULL(_oHTML.Body) _oHTML.Body.AddItem(_oHTML.oRecord.BodyEnd) ENDIF DO CASE CASE lnShow=1 llSuccessful=_oHTML.ViewSource() CASE lnShow=2 llSuccessful=_oHTML.Show() CASE lnShow#5 llSuccessful=_oHTML.SaveFile() ENDCASE IF VARTYPE(_oHTML)#"O" _oHTML=.NULL. RETURN .NULL. ENDIF IF NOT llSuccessful _MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+_oHTML.cOutFile+[".]) ENDIF IF NOT ll_oHTMLPublic _oHTML.Release _oHTML=.NULL. RETURN .NULL. ENDIF RETURN _oHTML *-- Dummy lines for adding files to project. DO RunCode.prg FUNCTION _EvalLinks(tcLinks,toObject,tcType) LOCAL lcLinks1,lcLinks2,lcLink,lnLinkTotal,lnCount,lnAtPos,lnLastRecNo lcLinks1=_TransformLinks(tcLinks) IF EMPTY(lcLinks1) RETURN "" ENDIF lnLastRecNo=IIF(EOF() OR RECNO()>RECCOUNT(),0,RECNO()) lcLinks2="" lnLinkTotal=(OCCURS(";",lcLinks1)+1) FOR lnCount = 1 TO lnLinkTotal IF lnCount0 GO lnLastRecNo ENDIF RETURN lcLinks2 ENDFUNC FUNCTION _TransformLinks(tcLinks) LOCAL lcLinks IF EMPTY(tcLinks) RETURN "" ENDIF lcLinks=STRTRAN(STRTRAN(STRTRAN(STRTRAN(ALLTRIM(tcLinks),CR_LF,";"), ; LF,";"),CR,";"),",",";") IF LEFT(lcLinks,1)==";" lcLinks=ALLTRIM(SUBSTR(lcLinks,2)) ENDIF IF RIGHT(lcLinks,1)==";" lcLinks=ALLTRIM(LEFT(lcLinks,LEN(lcLinks)-1)) ENDIF RETURN lcLinks ENDFUNC FUNCTION _InheritProperties(toObject,toNewObject) IF EMPTY(toObject.Type) AND NOT EMPTY(toNewObject.Type) toObject.Type=toNewObject.Type ENDIF IF EMPTY(toObject.Text) AND NOT EMPTY(toNewObject.Text) toObject.Text=toNewObject.Text ENDIF IF EMPTY(toObject.Desc) AND NOT EMPTY(toNewObject.Desc) toObject.Desc=toNewObject.Desc ENDIF IF EMPTY(toObject.ClassName) AND NOT EMPTY(toNewObject.ClassName) toObject.ClassName=toNewObject.ClassName ENDIF IF EMPTY(toObject.ClassLib) AND NOT EMPTY(toNewObject.ClassLib) toObject.ClassLib=toNewObject.ClassLib ENDIF IF EMPTY(toObject.Module) AND NOT EMPTY(toNewObject.Module) toObject.Module=toNewObject.Module ENDIF IF EMPTY(toObject.Picture) AND NOT EMPTY(toNewObject.Picture) toObject.Picture=toNewObject.Picture ENDIF toObject.Properties=_InheritProperty(toObject.Properties,toNewObject.Properties) toObject.HTML=_InheritProperty(toObject.HTML,toNewObject.HTML) toObject.Style=_InheritProperty(toObject.Style,toNewObject.Style) toObject.Script=_InheritProperty(toObject.Script,toNewObject.Script) toObject.PreScript=_InheritProperty(toObject.PreScript,toNewObject.PreScript) toObject.GenScript=_InheritProperty(toObject.GenScript,toNewObject.GenScript) toObject.PostScript=_InheritProperty(toObject.PostScript,toNewObject.PostScript) toObject.HeadStart=_InheritProperty(toObject.HeadStart,toNewObject.HeadStart) toObject.BodyStart=_InheritProperty(toObject.BodyStart,toNewObject.BodyStart) toObject.BodyEnd=_InheritProperty(toObject.BodyEnd,toNewObject.BodyEnd) toObject.HeadEnd=_InheritProperty(toObject.HeadEnd,toNewObject.HeadEnd) IF NOT EMPTY(toNewObject.BodyEnd) IF EMPTY(toObject.BodyEnd) toObject.BodyEnd=toNewObject.BodyEnd ELSE toObject.BodyEnd=toObject.BodyEnd+CR_LF+toNewObject.BodyEnd ENDIF ENDIF IF EMPTY(toObject.Comment) AND NOT EMPTY(toNewObject.Comment) toObject.Comment=toNewObject.Comment ENDIF IF EMPTY(toObject.User) AND NOT EMPTY(toNewObject.User) toObject.User=toNewObject.User ENDIF ENDFUNC FUNCTION _InheritProperty(tcValue,tcNewValue) IF EMPTY(tcNewValue) RETURN tcValue ENDIF IF EMPTY(tcValue) RETURN tcNewValue ENDIF IF RIGHT(tcNewValue,2)==CR_LF RETURN tcNewValue+tcValue ENDIF RETURN tcNewValue+CR_LF+tcValue ENDFUNC FUNCTION _CheckGenHTMLTableStructure(tcFileName,tcAlias,tcHTMLVCX) LOCAL lcFileName,lcAlias,lcAlias2,lcPath,lcLastOnError,oRecord,lcID,lcVersion LOCAL lcFileName2DBF,lcFileName2FPT,oHTMLCreateTable lcFileName=LOWER(tcFileName) lcPath=IIF(EMPTY(lcFileName),"",JUSTPATH(lcFileName)+"\") lcAlias=LOWER(ALLTRIM(tcAlias)) IF USED(lcAlias) IF NOT EMPTY(ALIAS()) AND NOT lcAlias==LOWER(ALIAS()) AND DBF(lcAlias)==DBF() lcAlias=LOWER(ALIAS()) ENDIF ELSE SELECT 0 IF FILE(lcFileName) USE (lcFileName) AGAIN SHARED ALIAS (lcAlias) IF NOT USED() RETURN .F. ENDIF ENDIF ENDIF IF RECCOUNT()=0 USE oHTMLCreateTable=NEWOBJECT("_HTMLCreateTable",tcHTMLVCX,"") oHTMLCreateTable.CreateTable(lcFileName) lcLastOnError=ON("ERROR") ON ERROR =.F. USE (lcFileName) AGAIN SHARED ALIAS (lcAlias) IF EMPTY(lcLastOnError) ON ERROR ELSE ON ERROR &lcLastOnError ENDIF IF NOT USED() _MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+lcFileName+[".]) RETURN .F. ENDIF RETURN ENDIF LOCATE FOR LOWER(ALLTRIM(ID))=LOWER(VFP_DEFAULT_ID) lcVersion=IIF(TYPE(lcAlias+".Version")=="M",ALLTRIM(Version),"") oHTMLCreateTable=NEWOBJECT("_HTMLCreateTable",tcHTMLVCX,"") IF VARTYPE(oHTMLCreateTable)#"O" OR (FCOUNT()>=25 AND FIELD(25)=="SAVE" AND ; lcVersion>=oHTMLCreateTable.cTableVersion) RETURN ENDIF lcVersion=oHTMLCreateTable.cTableVersion lcLastOnError=ON("ERROR") ON ERROR =.F. USE IN (lcAlias) SELECT 0 USE (lcFileName) AGAIN SHARED ALIAS (lcAlias) IF EMPTY(lcLastOnError) ON ERROR ELSE ON ERROR &lcLastOnError ENDIF IF NOT USED() _MsgBox(M_FILE_LOC+[ "]+lcFileName+[" ]+M_COULD_NOT_OPENED_EXCL_LOC) RETURN .F. ENDIF lcFileName2DBF=LOWER(FORCEPATH(FORCEEXT(lcFileName,"")+"__2",lcPath)) lcFileName2FPT=lcFileName2DBF+".fpt" lcFileName2DBF=lcFileName2DBF+".dbf" ERASE (lcFileName2DBF) ERASE (lcFileName2FPT) IF TYPE(lcAlias+".Save")=="L" COPY TO (lcFileName2DBF) FOR Save AND NOT LOWER(ALLTRIM(ID))=LOWER(VFP_DEFAULT_ID) ENDIF USE IN (lcAlias) SELECT 0 ERASE (lcFileName) oHTMLCreateTable.CreateTable(lcFileName) lcLastOnError=ON("ERROR") ON ERROR =.F. USE (lcFileName) AGAIN SHARED ALIAS (lcAlias) IF EMPTY(lcLastOnError) ON ERROR ELSE ON ERROR &lcLastOnError ENDIF IF NOT USED() ERASE (lcFileName2DBF) ERASE (lcFileName2FPT) _MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+lcFileName+[".]) RETURN .F. ENDIF IF NOT FILE(lcFileName2DBF) RETURN ENDIF lcAlias2=LOWER(SYS(2015)) LOCATE FOR LOWER(ALLTRIM(ID))=LOWER(VFP_DEFAULT_ID) REPLACE Version WITH lcVersion SELECT 0 lcLastOnError=ON("ERROR") ON ERROR =.F. USE (lcFileName2DBF) AGAIN SHARED ALIAS (lcAlias2) SCAN ALL lcID=LOWER(ALLTRIM(ID)) SCATTER MEMO NAME oRecord SELECT (lcAlias) IF EMPTY(lcID) APPEND BLANK ELSE LOCATE FOR LOWER(ALLTRIM(ID))==lcID IF EOF() APPEND BLANK ENDIF ENDIF GATHER MEMO NAME oRecord SELECT (lcAlias) ENDSCAN IF EMPTY(lcLastOnError) ON ERROR ELSE ON ERROR &lcLastOnError ENDIF USE ERASE (lcFileName2DBF) ERASE (lcFileName2FPT) SELECT (lcAlias) LOCATE ENDFUNC FUNCTION _MsgBox(tcMessage,tnType) LOCAL lnType,lnResult,lnLastSelect IF _vfp.StartMode>0 RETURN 6 ENDIF lnType=IIF(VARTYPE(tnType)=="N",tnType,16) lnLastSelect=SELECT() SELECT 0 WAIT CLEAR lnResult=MESSAGEBOX(tcMessage,lnType,M_GENHTML_LOC) WAIT CLEAR SELECT (lnLastSelect) RETURN lnResult ENDFUNC DEFINE CLASS _SaveEnvironment AS Custom cGenHTMLAlias="" nGenHTMLRecNo=0 cGenHTMLTable="" nLastSelect=0 nLastRecNo=0 nLastSetMemoWidth=0 cLastSetMessageBar="" cLastSetSafety="" cLastSetTalk="" cWindow="" lWindow=.F. FUNCTION Init this.cLastSetTalk=SET("TALK") SET TALK OFF this.cLastSetSafety=SET("SAFETY") SET SAFETY OFF this.nLastSetMemoWidth=SET("MEMOWIDTH") SET MEMOWIDTH TO 1024 this.cLastSetMessageBar=SET("MESSAGE",1) SET MESSAGE TO "" this.nLastSelect=SELECT() this.nLastRecNo=IIF(EOF() OR RECNO()>RECCOUNT(),0,RECNO()) ENDFUNC FUNCTION Destroy IF NOT EMPTY(this.cWindow) AND WEXIST(this.cWindow) IF this.lWindow SHOW WINDOW (M_PROPERTIES_LOC) ENDIF RELEASE WINDOW (this.cWindow) ENDIF SET MEMOWIDTH TO (this.nLastSetMemoWidth) IF USED(this.cGenHTMLAlias) USE IN (this.cGenHTMLAlias) ENDIF SELECT (this.nLastSelect) IF USED() AND this.nLastRecNo>0 GO this.nLastRecNo ENDIF IF EMPTY(this.cLastSetMessageBar) SET MESSAGE TO ELSE SET MESSAGE TO (this.cLastSetMessageBar) ENDIF IF this.cLastSetSafety=="ON" SET SAFETY ON ELSE SET SAFETY OFF ENDIF IF this.cLastSetTalk=="ON" SET TALK ON ELSE SET TALK OFF ENDIF ENDFUNC ENDDEFINE *-- end GenHTML.PRG